perm filename MLST.F4[MLI,LCS]1 blob
sn#158096 filedate 1975-05-05 generic text, type T, neo UTF8
C MLST.F4 ---- MAILING LIST PROGRAM---- SPRING 75
C LOAD WITH MSFAIL[MSS,LCS] (FOR LOOKD)
COMMON JA
DIMENSION JA(11,200),JB(7,200),JC(7,200),JD(7,200),JE(7,200),
1 NA(11)
IQQ=0
102 U=0
8 K=0
NB=0
TYPE 6
6 FORMAT(' NEW FILE OR OLD? '$)
ACCEPT 10,M
IF(M.EQ.' '.AND.U.EQ.1)GO TO 43
TYPE 22
22 FORMAT(' TYPE A FILE NAME UP TO 5 LETTERS LONG. '$)
ACCEPT 23,F
23 FORMAT(A5)
IF(F.EQ.' ')GO TO 8
IF(M.EQ.'O')GO TO 43
10 FORMAT(A1)
200 FORMAT(1XI1,4X$)
15 TYPE 7
7 FORMAT(' TYPE:NAME ON LINE 1,ADDRESS ON LINES 2,3 AND 4,'/
1 ' AND UP TO 7 ONE LETTER LIST NAMES ON LINE 5.'/)
NB=1
2 K=K+1
TYPE 3
3 FORMAT(' IF FINISHED TYPE <CR>.'/)
ACCEPT 9,(JA(I,K),I=1,11)
9 FORMAT(5A1,6A5)
IF(JA(1,K).EQ.' ')GO TO 33
IQQ=-1
L=2
TYPE 200,L
ACCEPT 11,(JB(I,K),I=1,7)
11 FORMAT(7A5)
L=3
TYPE 200,L
ACCEPT 11,(JC(I,K),I=1,7)
L=4
TYPE 200,L
ACCEPT 11,(JE(I,K),I=1,7)
L=5
TYPE 200,L
ACCEPT 20,(JD(I,K),I=1,7)
20 FORMAT(7A1)
GO TO 2
43 IF(LOOKD(F))GO TO 44
TYPE 58,F
58 FORMAT(1XA5,' FILE NOT FOUND.'/)
GO TO 102
44 REWIND 1
CALL IFILE(1,F)
READ(1)K,((JB(I,L),I=1,7),L=1,K)
READ(1)((JA(I,L),I=1,11),L=1,K)
READ(1)((JC(I,L),I=1,7),L=1,K)
READ(1)((JE(I,L),I=1,7),L=1,K)
READ(1)((JD(I,L),I=1,7),L=1,K),K
134 TYPE 66
66 FORMAT(' TYPE ADD,CHANGE,DELETE OR <CR> FOR PRINTOUT. '$)
ACCEPT 10,P
IF(P.EQ.'A')GO TO 15
IF(P.NE.'C'.AND.P.NE.'D')GO TO 146
110 TYPE 111
111 FORMAT(' TYPE NAME OR IF FINISHED TYPE <CR>.'/)
ACCEPT 9,(NA(I),I=1,11)
IF(NA(1).EQ.' ')GO TO 134
IQQ=-1
DO 114 N=1,K
J=0
DO 114 I=1,11
IF(JA(I,N).EQ.NA(I))J=J+1
IF(J.EQ.11)GO TO 148
114 CONTINUE
TYPE 116
116 FORMAT(' NAME NOT FOUND.'/)
GO TO 134
148 IF(P.EQ.'D')GO TO 149
NB=1
TYPE 117
117 FORMAT(' TYPE NEW NAME OR <CR> FOR NO CHANGE.'/)
ACCEPT 9,(NA(I),I=1,11)
IF(NA(1).EQ.' ')GO TO 119
DO 131 I=1,11
131 JA(I,N)=NA(I)
119 TYPE 136,(JB(I,N),I=1,7)
TYPE 121
121 FORMAT(' TYPE NEW ADDRESS LINE OR <CR> FOR NO CHANGE.'/)
ACCEPT 11,(NA(I),I=1,7)
136 FORMAT(1X7A5)
IF(NA(1).EQ.' ')GO TO 122
DO 123 I=1,7
123 JB(I,N)=NA(I)
122 TYPE 136,(JC(I,N),I=1,7)
TYPE 121
ACCEPT 11,(NA(I),I=1,7)
IF(NA(1).EQ.' ')GO TO 300
DO 125 I=1,7
125 JC(I,N)=NA(I)
300 TYPE 136,(JE(I,N),I=1,7)
TYPE 121
ACCEPT 11,(NA(I),I=1,7)
IF(NA(1).EQ.' ')GO TO 124
DO 301 I=1,7
301 JE(I,N)=NA(I)
124 TYPE 137,(JD(I,N),I=1,7)
137 FORMAT(1X7A1)
TYPE 127
127 FORMAT(' TYPE NEW LIST NAMES OR <CR> FOR NO CHANGE.'/)
ACCEPT 20,(NA(I),I=1,7)
IF(NA(1).EQ.' ')GO TO 134
DO 129 I=1,7
129 JD(I,N)=NA(I)
GO TO 134
33 K=K-1
P=' '
146 IF(NB.EQ.0)GO TO 132
104 JK=1
JX=1
1004 L=LN(JK)
DO 2004 J=JK+1,K
N=LN(J)
IF(L.LE.N)GO TO 2004
L=N
JX=J
2004 CONTINUE
IF(JX.EQ.JK)GO TO 8004
DO 3004 J=1,11
CALL EXCH(JA(J,JX),JA(J,JK))
IF(J.GT.7)GO TO 3004
CALL EXCH(JB(J,JX),JB(J,JK))
CALL EXCH(JC(J,JX),JC(J,JK))
CALL EXCH(JD(J,JX),JD(J,JK))
CALL EXCH(JE(J,JX),JE(J,JK))
3004 CONTINUE
8004 JK=JK+1
JX=JK
IF(JK.LT.K)GO TO 1004
GO TO 132
6004 FORMAT(' DELETE THIS ONE? '$)
149 L=LN(N)
JS=-1
DO 5004 J=1,K-1
IF(L.NE.LN(J))GO TO 5004
TYPE 6004
ACCEPT 20,N
IF(N.EQ.'N')GO TO 5004
DO 7004 JJ=J,K
JS=JJ+1
DO 7004 JQ=1,11
JA(JQ,JJ)=JA(JQ,JS)
IF(JQ.GT.7)GO TO 7004
JB(JQ,JJ)=JB(JQ,JS)
JC(JQ,JJ)=JC(JQ,JS)
JD(JQ,JJ)=JD(JQ,JS)
JE(JQ,JJ)=JE(JQ,JS)
7004 CONTINUE
IF(JS)GO TO 134
K=K-1
NB=NB+NB
GO TO 134
5004 CONTINUE
GO TO 134
132 IF(IQQ.EQ.0)GO TO 60
REWIND 1
CALL OFILE(1,F)
WRITE(1)K,((JB(I,L),I=1,7),L=1,K),K
WRITE(1)((JA(I,L),I=1,11),L=1,K),K
WRITE(1)((JC(I,L),I=1,7),L=1,K),K
WRITE(1)((JE(I,L),I=1,7),L=1,K),K
WRITE(1)((JD(I,L),I=1,7),L=1,K),K,K
END FILE 1
60 TYPE 77
77 FORMAT(' TYPE LIST NAME OR <CR> FOR ALL LISTS.'/)
ACCEPT 10,JF
Y=' '
IF(JF.EQ.' ')GO TO 53
N=1
DO 99 L=1,K
DO 97 I=1,7
IF(JD(I,L).EQ.JF)GO TO 98
97 CONTINUE
GO TO 99
98 DO 51 M=1,11
51 JA(M,N)=JA(M,L)
DO 100 M=1,7
JB(M,N)=JB(M,L)
JC(M,N)=JC(M,L)
JE(M,N)=JE(M,L)
100 JD(M,N)=JD(M,L)
N=N+1
99 CONTINUE
K=N-1
53 Y='Y'
TYPE 13
13 FORMAT(' TTY OR LINE PRINTER?'/)
ACCEPT 10,T
IF(T.NE.'L')GO TO 103
TYPE 88
88 FORMAT(' PRINT WITH LIST NAMES?'/)
ACCEPT 10,Y
103 LIST=5
IF(T.EQ.'L')LIST=3
WRITE(LIST,91)F,JF
91 FORMAT(//28XA5,' FILE',4XA1,' LIST'/)
ID=1
DO 45 J=1,K,2
IF(K.EQ.J)ID=0
NN=J+ID
WRITE(LIST,19)((JA(I,L),I=1,11),L=J,NN)
19 FORMAT(//2(2X5A1,6A5))
WRITE(LIST,46)((JB(I,L),I=1,7),L=J,NN)
46 FORMAT(2(2X7A5))
WRITE(LIST,46)((JC(I,L),I=1,7),L=J,NN)
WRITE(LIST,46)((JE(I,L),I=1,7),L=J,NN)
IF(Y.NE.'Y')GO TO 45
WRITE(LIST,48)((JD(I,L),I=1,7),L=J,NN)
48 FORMAT(/5X7A1,30X7A1)
45 CONTINUE
IF(T.EQ.'L')CALL EXIT
U=1
GO TO 8
END
FUNCTION LN(M)
COMMON JA(11,200)
MX=100000000
LN=0
DO 1 K=1,5
J=JA(K,M)
IF(J)LN=LN+(1-('A'-J)/536870912)*MX
C ONLY LOOKS AT LETTERS (A-Z ARE NEG.)
1 MX=MX/100
RETURN
END
SUBROUTINE EXCH(J,K)
L=J
J=K
K=L
END